home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-01 / dkbuts.zip / CHEM2DKB.BAS < prev    next >
BASIC Source File  |  1991-05-16  |  6KB  |  205 lines
  1. '===================================================================
  2. ' CHEM2DKB.BAS
  3. ' By Dan Farmer
  4. ' November, 1990
  5. ' Generates DKB script for molecular models generated by CHEM.EXE, a
  6. ' public domain software package by Larry Puhl"
  7. ' Updated to DKB 2.11 by Aaron A. Collins 05/01/91
  8. '====================================================================
  9.  
  10. '          ---  FORMAT A NUMERIC STRING
  11. DEF FNFMT$ (A#)
  12.     FORM$="-####.###"
  13.     STATIC SIGN, S$, P, A$, DEC, W$, F$, WF$, FF$, PAD$, ADD$
  14. '
  15.     SIGN = SGN(A#)
  16.     A# = ABS(A#)
  17.  
  18. '          ---  SEPARATE WHOLE AND FRACTIONAL PARTS OF NUMBER
  19.     W$ = MID$(STR$(INT(A#)), 2)
  20.     IF W$ = "" THEN W$ = "0"
  21.     S$ = STR$(1 + A#)
  22.     P = INSTR(S$, ".")
  23.     IF P = 0 THEN
  24.         F$ = ""
  25.        ELSE F$ = MID$(S$, P + 1)
  26.     END IF
  27.  
  28. '          ---  SEPARATE WHOLE AND FRACTION FORMAT STRINGS
  29.     DEC = INSTR(FORM$, ".")
  30.     IF DEC = 0 THEN
  31.         WF$ = FORM$: FF$ = ""
  32.        ELSE WF$ = LEFT$(FORM$, DEC - 1)
  33.         FF$ = MID$(FORM$, DEC + 1)
  34.     END IF
  35.  
  36.     ADD$ = "": PAD$ = " "
  37.  
  38. '          ---  ADD SIGN CHARACTER
  39.     IF LEFT$(WF$, 1) = "-" THEN
  40.         WF$ = MID$(WF$, 2)
  41.         IF SIGN = -1 THEN
  42.             ADD$ = ADD$ + "-"
  43.            ELSE ADD$ = ADD$ + " "
  44.         END IF
  45.     END IF
  46.     
  47. '          ---  HANDLE NUMERIC OVERFLOW AND UNDERFLOW
  48.     IF LEN(W$) > LEN(WF$) THEN W$ = "%" + RIGHT$(W$, LEN(WF$) - 1)
  49.     IF LEN(F$) > LEN(FF$) THEN F$ = LEFT$(F$, LEN(FF$))
  50. '          ---  FORMAT THE NUMBER STRING
  51.     IF DEC > 0 THEN W$ = W$ + "." + F$ + STRING$(LEN(FF$) - LEN(F$), "0")
  52.     FNFMT$ = ADD$ + W$
  53. END DEF
  54.  
  55. DIM BUFF$(4)
  56. DIM COLORTAB$(16)
  57. COLORTAB$(00)="Black"
  58. COLORTAB$(01)="Blue"
  59. COLORTAB$(02)="Green"
  60. COLORTAB$(03)="Cyan"
  61. COLORTAB$(04)="Red"
  62. COLORTAB$(05)="Magenta"
  63. COLORTAB$(06)="Brown"
  64. COLORTAB$(07)="LightGray"
  65. COLORTAB$(08)="Gray"
  66. COLORTAB$(09)="LightBlue"
  67. COLORTAB$(10)="LimeGreen"
  68. COLORTAB$(11)="Turquoise"
  69. COLORTAB$(12)="Pink"
  70. COLORTAB$(13)="Plum"
  71. COLORTAB$(14)="Yellow"
  72. COLORTAB$(14)="White"
  73.  
  74. INFILE$=COMMAND$
  75. IF COMMAND$="" THEN
  76.     PRINT "CHEM2DKB.EXE infile[.dat]"
  77.     PRINT "    Converts CHEM.EXE Version 2.0 data file to DKB datafile."
  78.     PRINT "    Output file uses root name of input file, adds .DKB extension."
  79.     PRINT
  80.     END
  81. END IF
  82. ADOT=INSTR(INFILE$,".")
  83. IF ADOT > 0 THEN                                 ' IF AN EXTENSION SPECIFIED
  84.     ROOTNAME$=LEFT$(INFILE$,ADOT-1)              ' GET ROOT FILENAME
  85. ELSE
  86.     ROOTNAME$=INFILE$
  87.     INFILE$=ROOTNAME$+".DAT"                     ' RE-CREATE IN FILENAME
  88. END IF
  89. OUTFILE$=ROOTNAME$+".DKB"                        ' CREATE OUTPUT FROM ROOT
  90.  
  91. OPEN INFILE$ FOR INPUT AS #1
  92. OPEN OUTFILE$ FOR OUTPUT AS #2
  93.  
  94. PRINT "Reading "; INFILE$
  95. PRINT "Writing "; OUTFILE$
  96.  
  97. WHILE NOT EOF(1)
  98.     INPUT #1, A$
  99.     IF LEFT$(A$,13) = "chemical_name" THEN
  100.     TITLE$=MID$(A$,16,LEN(A$)-2)
  101.         GOSUB WRITE.HEADER
  102.     ELSEIF LEFT$(A$,12)="atomlocation" THEN
  103.         GOSUB WRITE.ATOM
  104.     END IF
  105. WEND
  106. GOSUB WRITE.FOOTER
  107.  
  108. CLOSE #1: CLOSE #2
  109. PRINT "CHEM2DKB Finished."
  110. END
  111.  
  112. WRITE.HEADER:
  113.     PRINT #2, "{
  114.     PRINT #2, "DKB 2.11 Data file for ";TITLE$
  115.     PRINT #2, "Generated from CHEM.EXE Version 2.0 data file by CHEM2DKB.EXE"
  116.     PRINT #2, "    CHEM.EXE by Larry Puhl"
  117.     PRINT #2, "    CHEM2DKB by Dan Farmer
  118.     PRINT #2, "    Updated to DKB 2.11 by Aaron A. Collins"
  119.     PRINT #2, "}"
  120.     PRINT #2, ""
  121.     PRINT #2, "INCLUDE "+CHR$(34)+"shapes.dat"+CHR$(34)
  122.     PRINT #2, "INCLUDE "+CHR$(34)+"colors.dat"+CHR$(34)
  123.     PRINT #2, "INCLUDE "+CHR$(34)+"textures.dat"+CHR$(34)
  124.     PRINT #2, ""
  125.     PRINT #2, "VIEW_POINT"
  126.     PRINT #2, "    LOCATION <0.0  0.0  -10.0>     {Z may need modification}"
  127.     PRINT #2, "    DIRECTION <0.0 0.0  2.0>"
  128.     PRINT #2, "    UP  <0.0  1.0  0.0>"
  129.     PRINT #2, "    RIGHT <1.33333 0.0 0.0>"
  130.     PRINT #2, "    LOOK_AT <0.0  0.0  0.0>"
  131.     PRINT #2, "END_VIEW_POINT"
  132.     PRINT #2,
  133.  
  134.     PRINT #2, "OBJECT"
  135.     PRINT #2, "    SPHERE <0.0  0.0  0.0>  2.0 END_SPHERE"
  136.     PRINT #2, "    TRANSLATE <500.0  500.0  -100.0> {Z may need modification}"
  137.     PRINT #2, "    TEXTURE"
  138.     PRINT #2, "        COLOUR White"
  139.     PRINT #2, "        AMBIENT 1.0"
  140.     PRINT #2, "        DIFFUSE 0.0"
  141.     PRINT #2, "    END_TEXTURE"
  142.     PRINT #2, "    LIGHT_SOURCE"
  143.     PRINT #2, "    COLOUR White"
  144.     PRINT #2, "END_OBJECT"
  145.     PRINT #2,
  146.  
  147.     PRINT #2, "OBJECT"
  148.     PRINT #2, "    SPHERE <0.0  0.0  0.0>  2.0 END_SPHERE"
  149.     PRINT #2, "    TRANSLATE <-500.0  50.0  -1000.0> {Z may need modification}"
  150.     PRINT #2, "    TEXTURE"
  151.     PRINT #2, "        COLOUR DimGrey"
  152.     PRINT #2, "        AMBIENT 1.0"
  153.     PRINT #2, "        DIFFUSE 0.0"
  154.     PRINT #2, "    END_TEXTURE"
  155.     PRINT #2, "    LIGHT_SOURCE"
  156.     PRINT #2, "    COLOUR DimGrey"
  157.     PRINT #2, "END_OBJECT"
  158.     PRINT #2,
  159.  
  160.     PRINT #2,
  161.     PRINT #2,"COMPOSITE"
  162. RETURN
  163. WRITE.ATOM:
  164.     FOR I = 1 TO 4
  165.         INPUT #1,B$                              ' READ X,Y,Z ,& R
  166.         BUFF$(I)=B$                              ' SAVE FOR MASSAGING
  167.     NEXT I
  168.     FOR I=1 TO 4                                 ' READ UP TO COLOR CODE
  169.         INPUT #1,B$
  170.     NEXT I
  171.     '***  B$ SHOULD NOW HOLD AN EGA COLOR NUMBER AND A RIGHT PAREN
  172.     COLOR$=COLORTAB$(VAL(B$))
  173.  
  174.  
  175.  
  176.     '*** GET X,Y,Z VALUES & CONVERT TO ANGSTROM UNITS (DIVIDE BY 1300)
  177.     X=VAL(MID$(BUFF$(1),3))/1300                  ' STRIP LEADING "l("
  178.     Y=VAL(BUFF$(2))/1300
  179.     Z=VAL(BUFF$(3))/1300
  180.  
  181.     '*** RADIUS: (ALREADY IN ANGSTROM UNITS)
  182.     R=VAL(BUFF$(4))
  183.  
  184.     '*** CONVERT TO FORMATTED STRINGS
  185.     X$=FNFMT$(X) : Y$=FNFMT$(Y) : Z$=FNFMT$(Z) : R$=FNFMT$(R)
  186.  
  187.     PRINT #2, "    OBJECT"
  188.     PRINT #2, "        SPHERE <"; X$;" "; Y$;" "; Z$" ";; "> ";R$;" END_SPHERE"
  189.     PRINT #2, "        TEXTURE"
  190.     PRINT #2, "            COLOUR " ; COLOR$
  191.     PRINT #2, "            AMBIENT 0.3"
  192.     PRINT #2, "            DIFFUSE 0.7"
  193.     PRINT #2, "            PHONG 1.0"
  194.     PRINT #2, "            PHONGSIZE 40.0"
  195.     PRINT #2, "        END_TEXTURE"
  196.     PRINT #2, "        COLOUR " ; COLOR$
  197.     PRINT #2, "    END_OBJECT"
  198. RETURN
  199.  
  200. WRITE.FOOTER:
  201.     PRINT #2,"TRANSLATE <0.0  0.0  0.0>"
  202.     PRINT #2,"ROTATE    <0.0  0.0  0.0>"
  203.     PRINT #2,"END_COMPOSITE"
  204. RETURN
  205.